home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / Clipboard / WriteClip.p < prev   
Encoding:
Text File  |  1997-05-06  |  3.2 KB  |  142 lines
  1. Program WriteClip;
  2.  
  3. { WriteClip - schreibt Text ins dem Clipboard
  4.   Die Routine ist so geschrieben, daß sie leicht in
  5.   eigene Programme eingebaut werden kann.
  6.  
  7.   PUBLIC DOMAIN
  8.  
  9.   Andreas Tetzl     A.Tetzl@saxonia.de
  10. }
  11.  
  12.  
  13. {$I "Include:Exec/Devices.i"}
  14. {$I "Include:Exec/IO.i"}
  15. {$I "Include:Devices/ClipBoard.i"}
  16. {$I "Include:Exec/Memory.i"}
  17. {$I "Include:Utils/IOUtils.i"}
  18. {$I "Include:DOS/DOS.i"}
  19. {$I "Include:Utils/StringLib.i"}
  20. {$I "Include:Utils/Parameters.i"}
  21.  
  22. VAR Str : String;
  23.     err : Integer;
  24.  
  25. {///"FUNCTION CreateExtIO"}
  26. FUNCTION CreateExtIO( iop : MsgPortPtr; iosize : Integer) : Address;
  27. VAR
  28.     ExtIO : IOStdReqPtr;
  29.  
  30. Begin
  31.   If iop = NIl then CreateExtIO := NIL;
  32.   ExtIO := AllocMem( iosize, Memf_Public+Memf_Clear );
  33.   If ExtIO = NIL then CreateExtIO := NIL;
  34.  
  35.   With ExtIO^.io_message do begin
  36.     mn_node.ln_Type := NT_Message;
  37.     mn_Length := iosize;
  38.     mn_ReplyPort := iop;
  39.   End;
  40.   CreateExtIO := ExtIO;
  41. End;
  42. {///}
  43.  
  44. {///"PROCEDURE DeleteExtIO"}
  45. Procedure DeleteExtIO( iorp : IOStdReqPtr );
  46. Begin
  47.   With iorp^ do begin
  48.     io_Message.mn_node.ln_Type := $FF;
  49.     io_Device := Address( -1 );         { * Verstümmeln *}
  50.     io_Unit   := Address( -1 );
  51.   End;
  52.   FreeMem( iorp, iorp^.io_Message.mn_Length );  { * Speicher freigeben * }
  53. End;
  54. {///}
  55.  
  56. { /// ------------------------- "FUNCTION WriteClip" ------------------------- }
  57.  
  58. FUNCTION WriteClip(Unit : Byte; Buffer : String; BufferSize : Integer) : Integer;
  59.  
  60. { Parameter:
  61.     Unit : Unit des Clipboard.device (normalerweise 0)
  62.     Buffer : String, der ins Clipboard geschrieben wird
  63.     BufferSize : Größe des Buffers
  64. }
  65.  
  66. { Rückgabe:
  67.     0 : Alles OK
  68.     1 : Clipboard.device konnte nicht geöffnet werden
  69. }
  70.  
  71. VAR err : Integer;
  72.     MyPort : MsgPortPtr;
  73.     MyReq  : IOClipReqPtr;
  74.     len : Integer;
  75.  
  76. PROCEDURE Clip_Write(Buffer : Address; size : Integer);
  77. BEGIN
  78.  MyReq^.io_Command:=CMD_WRITE;
  79.  MyReq^.io_Data:=Buffer;
  80.  MyReq^.io_Length:=size;
  81.  err:=DoIO(MyReq);
  82. END;
  83.  
  84. Begin
  85.  MyPort:=CreatePort(NIL,0);
  86.  If MyPort=NIL then WriteClip:=1;
  87.  
  88.  MyReq:=CreateExtIO(MyPort,SizeOf(IOClipReq));
  89.  If MyReq=NIL then
  90.   Begin
  91.    DeletePort(MyPort);
  92.    WriteClip:=1;
  93.   end;
  94.  
  95.  { Clipboard.device öffnen }
  96.  err:=OpenDevice("clipboard.device",UNIT,MyReq,0);
  97.  If err<>0 then
  98.   Begin
  99.    DeleteExtIO(IoStdReqPtr(MyReq));
  100.    DeletePort(MyPort);
  101.    WriteClip:=1;
  102.   end;
  103.  
  104.  Clip_Write("FORM",4);
  105.  len:=12+BufferSize;   { FTXT+CHRS+size+BufferSize }
  106.  If Odd(BufferSize) then Inc(len);
  107.  Clip_Write(adr(len),4);
  108.  Clip_Write("FTXTCHRS",8);
  109.  Clip_Write(adr(Buffersize),4);
  110.  Clip_Write(Buffer,BufferSize);
  111.  If Odd(BufferSize) then Clip_Write(NIL,1); { immer gerade Dateigröße }
  112.  
  113.  { fertig }
  114.  MyReq^.io_Command:=CMD_UPDATE;
  115.  err:=DoIO(MyReq);
  116.  
  117.  CloseDevice(MyReq);
  118.  DeleteExtIO(IoStdReqPtr(MyReq));
  119.  DeletePort(MyPort);
  120. end;
  121.  
  122. { /// ------------------------------------------------------------------------ }
  123.  
  124. { /// -------------------------------- "Main" -------------------------------- }
  125.  
  126. BEGIN
  127.  Str:=AllocString(100);
  128.  GetParam(1, Str);
  129.  If StrEq(Str,"") then
  130.   BEGIN
  131.    Writeln("Usage: WriteClip String");
  132.    Exit;
  133.   END;
  134.  
  135.  err:=WriteClip(0,Str,Strlen(Str));
  136.  
  137.  Writeln("String written to clipboard");
  138.  FreeString(Str);
  139. END.
  140.  
  141. { /// ------------------------------------------------------------------------ }
  142.